package JasPerl::Request;

use strict;
use warnings;

use JasPerl::Util::Enumeration;
use JasPerl::Util::Exceptions;
use JasPerl::Util::Locale;

use IO::Handle;
use URI;

use constant {
    BASIC_AUTH       => 'BASIC',
    CLIENT_CERT_AUTH => 'CLIENT_CERT',
    DIGEST_AUTH      => 'DIGEST',
    FORM_AUTH        => 'FORM'
};

my %DEFAULT_PORTS = (
    http => 80,
    https => 442
);

# Content-Type expressions
my $CHARSET = qr{ \b charset \s* = \s* ["']? \s* ( [^\s;,"']+ ) }sx;

# Accept-Language expressions
my $QVALUE        = qr{ \d+ (?: \. \d* )? }sx;
my $LANGUAGE_TAG  = qr{ [[:alpha:]]+ (?: - [[:alpha:]]+ )* }sx;
my $LANGUAGE_LIST = qr{ $LANGUAGE_TAG (?: , $LANGUAGE_TAG )* | [*] }sx;
my $LANGUAGE_Q    = qr{ ( $LANGUAGE_LIST ) (?: ; q= ( $QVALUE ) )? }sx;

# request attributes

sub get_attribute {
    # default implementation returns null
}

sub get_attribute_names {
    return JasPerl::Util::Enumeration::EMPTY_ENUMERATION;
}

sub set_attribute {
    # default implementation does nothing
}

sub remove_attribute {
    # default implementation does nothing
}

# request parameters

sub get_parameter {
    my $values = $_[0]->get_parameter_values($_[1])
        or return;
    return $values->[0];
}

sub get_parameter_names {
    return JasPerl::Util::Enumeration->from_list(
        keys %{$_[0]->get_parameter_map()}
    );
}

sub get_parameter_values {
    return $_[0]->get_parameter_map()->{$_[1]};
}

sub get_parameter_map {
    return { };
}

# request headers

sub get_header {
    my $headers = $_[0]->get_headers($_[1])
        or return;
    return unless $headers->has_next();
    return $headers->next();
}

sub get_headers {
    # default implementation returns null
}

sub get_header_names {
    # default implementation returns null
}

# request content

sub get_character_encoding {
    my $header = $_[0]->get_header('Content-Type')
        or return;
    return unless $header =~ $CHARSET;
    return $1;
}

sub get_content_type {
    return $_[0]->get_header('Content-Type');
}

sub get_content_length {
    my $header = $_[0]->get_header('Content-Length');
    return -1 unless defined $header;
    return $header;
}

sub get_reader {
    return IO::Handle->new();
}

# internationalization

sub get_locale {
    return $_[0]->get_locales()->next();
}

sub get_locales {
    my $self = shift;

    # get_headers may return undef
    my $headers = $self->get_headers('Accept-Language')
        or return JasPerl::Util::Enumeration->from_list(JasPerl::Util::Locale->get_default());

    my %prefs = ( );
    while ($headers->has_next()) {
        my $header = $headers->next();
        $header =~ s/\s+//g; # remove all ws

        while ($header =~ m{\G $LANGUAGE_Q ,?}sxg) {
            next if $1 eq '*';
            my $q = defined $2 ? $2 : 1;
            push @{$prefs{$q}}, split(',', $1);
        }
    }

    # adapted from I18N::LangTags::Detect
    my @tags = map { @{$prefs{$_}} } sort { $b <=> $a } keys %prefs
        or return JasPerl::Util::Enumeration->from_list(JasPerl::Util::Locale->get_default());

    return JasPerl::Util::Enumeration->from_list(
        map { JasPerl::Util::Locale->from_language_tag($_) } @tags
    );
}

# request uri components

sub get_scheme {
    return $_[0]->is_secure() ? 'https' : 'http';
}

sub get_method {
    # JasPerl::Util::UnsupportedOperationException->throw();
}

sub get_protocol {
    # JasPerl::Util::UnsupportedOperationException->throw();
}

sub get_server_name {
    my $self = shift;

    # HTTP Host header always takes precedence
    if (my $header = $self->get_header('Host')) {
        my ($name, $port) = split(':', $header, 2);
        return $name;
    } else {
        return $self->get_local_name();
    }
}

sub get_server_port {
    my $self = shift;

    # HTTP Host header always takes precedence
    if (my $header = $self->get_header('Host')) {
        my ($name, $port) = split(':', $header, 2);
        return $port || $DEFAULT_PORTS{$self->get_scheme()};
    } else {
        return $self->get_local_port();
    }
}

sub get_script_name {
    return '';
}

sub get_path_info {
    # default implementation returns null
}

sub get_path_translated {
    # default implementation returns null
}

sub get_query_string {
    # default implementation returns null
}

sub get_request_uri {
    my $self = shift;

    # if PATH_INFO is not empty, it MUST start with a forward slash
    if (my $path_info = $self->get_path_info()) {
        return URI->new($self->get_script_name() . $path_info);
    } else {
        return URI->new($self->get_script_name());
    }
}

sub get_request_url {
    my $self = shift;

    my $uri = $self->get_request_uri();
    $uri->scheme($self->get_scheme());

    if (my $host = $self->get_header('Host')) {
        $uri->authority($host);
    } else {
        my $name = $self->get_server_name();
        my $port = $self->get_server_port();
        $uri->authority($name . ':' . $port);
    }

    return $uri->canonical;
}

# cookies

sub get_cookies {
    # FIXME: use headers?
    # default implementation returns null
}

# authentication

sub get_auth_type {
    # TBD: auth header?
    # default implementation returns null
}

sub get_remote_user {
    # default implementation returns null
}

# SSL

sub is_secure {
    # default implementation returns false
}

# session

sub get_session {
    my ($self, $create) = @_;
    $create ||= not defined $create; # defaults to true

    return unless $create;
    JasPerl::Util::IllegalStateException->throw();
}

# protocol

sub get_local_addr {
    # FIXME: local_name -> gethostbyname
}

sub get_local_name {
    return $_[0]->get_local_addr();
}

sub get_local_port {
}

sub get_remote_addr {
    # FIXME: remote_name -> gethostbyname
}

sub get_remote_host {
    return $_[0]->get_remote_addr();
}

sub get_remote_port {
}

1;
